home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Tcl / tclGet.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-05-31  |  6.5 KB  |  254 lines
  1. /* 
  2.  * tclGet.c --
  3.  *
  4.  *    This file contains procedures to convert strings into
  5.  *    other forms, like integers or floating-point numbers or
  6.  *    booleans, doing syntax checking along the way.
  7.  *
  8.  * Copyright (c) 1990-1993 The Regents of the University of California.
  9.  * Copyright (c) 1994-1995 Sun Microsystems, Inc.
  10.  *
  11.  * See the file "license.terms" for information on usage and redistribution
  12.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13.  *
  14.  * SCCS: @(#) tclGet.c 1.24 96/02/15 11:42:47
  15.  */
  16.  
  17. #ifdef WIN32
  18. #  include <errno.h>
  19. #  include <math.h>
  20. #endif
  21. #include "tclInt.h"
  22. #include "tclPort.h"
  23.  
  24.  
  25. /*
  26.  *----------------------------------------------------------------------
  27.  *
  28.  * Tcl_GetInt --
  29.  *
  30.  *    Given a string, produce the corresponding integer value.
  31.  *
  32.  * Results:
  33.  *    The return value is normally TCL_OK;  in this case *intPtr
  34.  *    will be set to the integer value equivalent to string.  If
  35.  *    string is improperly formed then TCL_ERROR is returned and
  36.  *    an error message will be left in interp->result.
  37.  *
  38.  * Side effects:
  39.  *    None.
  40.  *
  41.  *----------------------------------------------------------------------
  42.  */
  43.  
  44. int
  45. Tcl_GetInt(interp, string, intPtr)
  46.     Tcl_Interp *interp;        /* Interpreter to use for error reporting. */
  47.     char *string;        /* String containing a (possibly signed)
  48.                  * integer in a form acceptable to strtol. */
  49.     int *intPtr;        /* Place to store converted result. */
  50. {
  51.     char *end, *p;
  52.     int i;
  53.  
  54.     /*
  55.      * Note: use strtoul instead of strtol for integer conversions
  56.      * to allow full-size unsigned numbers, but don't depend on strtoul
  57.      * to handle sign characters;  it won't in some implementations.
  58.      */
  59.  
  60.     errno = 0;
  61.     for (p = string; isspace(UCHAR(*p)); p++) {
  62.     /* Empty loop body. */
  63.     }
  64.     if (*p == '-') {
  65.     p++;
  66.     i = -(int)strtoul(p, &end, 0);
  67.     } else if (*p == '+') {
  68.     p++;
  69.     i = strtoul(p, &end, 0);
  70.     } else {
  71.     i = strtoul(p, &end, 0);
  72.     }
  73.     if (end == p) {
  74.     badInteger:
  75.         if (interp != (Tcl_Interp *) NULL) {
  76.             Tcl_AppendResult(interp, "expected integer but got \"", string,
  77.                     "\"", (char *) NULL);
  78.         }
  79.     return TCL_ERROR;
  80.     }
  81.     if (errno == ERANGE) {
  82.         if (interp != (Tcl_Interp *) NULL) {
  83.             interp->result = "integer value too large to represent";
  84.             Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
  85.                     interp->result, (char *) NULL);
  86.         }
  87.     return TCL_ERROR;
  88.     }
  89.     while ((*end != '\0') && isspace(UCHAR(*end))) {
  90.     end++;
  91.     }
  92.     if (*end != 0) {
  93.     goto badInteger;
  94.     }
  95.     *intPtr = i;
  96.     return TCL_OK;
  97. }
  98.  
  99. /*
  100.  *----------------------------------------------------------------------
  101.  *
  102.  * Tcl_GetDouble --
  103.  *
  104.  *    Given a string, produce the corresponding double-precision
  105.  *    floating-point value.
  106.  *
  107.  * Results:
  108.  *    The return value is normally TCL_OK;  in this case *doublePtr
  109.  *    will be set to the double-precision value equivalent to string.
  110.  *    If string is improperly formed then TCL_ERROR is returned and
  111.  *    an error message will be left in interp->result.
  112.  *
  113.  * Side effects:
  114.  *    None.
  115.  *
  116.  *----------------------------------------------------------------------
  117.  */
  118.  
  119. int
  120. Tcl_GetDouble(interp, string, doublePtr)
  121.     Tcl_Interp *interp;        /* Interpreter to use for error reporting. */
  122.     char *string;        /* String containing a floating-point number
  123.                  * in a form acceptable to strtod. */
  124.     double *doublePtr;        /* Place to store converted result. */
  125. {
  126.     char *end;
  127.     double d;
  128.  
  129.     errno = 0;
  130.     d = strtod(string, &end);
  131.     if (end == string) {
  132.     badDouble:
  133.         if (interp != (Tcl_Interp *) NULL) {
  134.             Tcl_AppendResult(interp,
  135.                     "expected floating-point number but got \"",
  136.                     string, "\"", (char *) NULL);
  137.         }
  138.     return TCL_ERROR;
  139.     }
  140.     if (errno != 0) {
  141.         if (interp != (Tcl_Interp *) NULL) {
  142. #ifdef STk_CODE
  143.             Tcl_AppendResult(interp, "incorrect floating-point \"",
  144.                  string, "\"", (char *) NULL);
  145. #else
  146.             TclExprFloatError(interp, d);
  147. #endif
  148.         }
  149.     return TCL_ERROR;
  150.     }
  151.     while ((*end != 0) && isspace(UCHAR(*end))) {
  152.     end++;
  153.     }
  154.     if (*end != 0) {
  155.     goto badDouble;
  156.     }
  157.     *doublePtr = d;
  158.     return TCL_OK;
  159. }
  160.  
  161. /*
  162.  *----------------------------------------------------------------------
  163.  *
  164.  * Tcl_GetBoolean --
  165.  *
  166.  *    Given a string, return a 0/1 boolean value corresponding
  167.  *    to the string.
  168.  *
  169.  * Results:
  170.  *    The return value is normally TCL_OK;  in this case *boolPtr
  171.  *    will be set to the 0/1 value equivalent to string.  If
  172.  *    string is improperly formed then TCL_ERROR is returned and
  173.  *    an error message will be left in interp->result.
  174.  *
  175.  * Side effects:
  176.  *    None.
  177.  *
  178.  *----------------------------------------------------------------------
  179.  */
  180.  
  181. int
  182. Tcl_GetBoolean(interp, string, boolPtr)
  183.     Tcl_Interp *interp;        /* Interpreter to use for error reporting. */
  184.     char *string;        /* String containing a boolean number
  185.                  * specified either as 1/0 or true/false or
  186.                  * yes/no. */
  187.     int *boolPtr;        /* Place to store converted result, which
  188.                  * will be 0 or 1. */
  189. {
  190.     int i;
  191.     char lowerCase[10], c;
  192.     size_t length;
  193.  
  194.     /*
  195.      * Convert the input string to all lower-case.
  196.      */
  197.  
  198.     for (i = 0; i < 9; i++) {
  199.     c = string[i];
  200.     if (c == 0) {
  201.         break;
  202.     }
  203.     if ((c >= 'A') && (c <= 'Z')) {
  204.         c += (char) ('a' - 'A');
  205.     }
  206.     lowerCase[i] = c;
  207.     }
  208.     lowerCase[i] = 0;
  209.  
  210.     length = strlen(lowerCase);
  211.     c = lowerCase[0];
  212. #ifdef STk_CODE
  213.     if (c == '#') {
  214.       if ((lowerCase[1] == 'f' && lowerCase[2] == '\0')) {
  215.     *boolPtr = 0;
  216.       }
  217.       else if ((lowerCase[1] == 't' && lowerCase[2] == '\0')) {
  218.     *boolPtr = 1;
  219.       }
  220.       else {
  221.     goto badBoolean;
  222.       }
  223. #endif
  224.     } else if ((c == '0') && (lowerCase[1] == '\0')) {
  225.     *boolPtr = 0;
  226.     } else if ((c == '1') && (lowerCase[1] == '\0')) {
  227.     *boolPtr = 1;
  228.     } else if ((c == 'y') && (strncmp(lowerCase, "yes", length) == 0)) {
  229.     *boolPtr = 1;
  230.     } else if ((c == 'n') && (strncmp(lowerCase, "no", length) == 0)) {
  231.     *boolPtr = 0;
  232.     } else if ((c == 't') && (strncmp(lowerCase, "true", length) == 0)) {
  233.     *boolPtr = 1;
  234.     } else if ((c == 'f') && (strncmp(lowerCase, "false", length) == 0)) {
  235.     *boolPtr = 0;
  236.     } else if ((c == 'o') && (length >= 2)) {
  237.     if (strncmp(lowerCase, "on", length) == 0) {
  238.         *boolPtr = 1;
  239.     } else if (strncmp(lowerCase, "off", length) == 0) {
  240.         *boolPtr = 0;
  241.     } else {
  242.         goto badBoolean;
  243.     }
  244.     } else {
  245.     badBoolean:
  246.         if (interp != (Tcl_Interp *) NULL) {
  247.             Tcl_AppendResult(interp, "expected boolean value but got \"",
  248.                     string, "\"", (char *) NULL);
  249.         }
  250.     return TCL_ERROR;
  251.     }
  252.     return TCL_OK;
  253. }
  254.